home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Unsorted / KnockOffGamePanel.AMOS / KnockOffGamePanel.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  2001-09-09  |  5.3 KB  |  208 lines
  1. Global BMP,WX,WY
  2. Dim DIT(3,7)
  3. Global DIT()
  4. Restore DITHER
  5. For Y=0 To 7
  6.   For X=0 To 3
  7.     Read DIT(X,Y)
  8.   Next 
  9. Next 
  10. WX=800 : WY=600
  11. Reserve As Work 8,WX*WY
  12. Screen Open 0,WX,WY,16,$8004
  13. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  14. 'For A=0 To 15 : Colour A*2,A*$111 : Colour A*2+1,Min(A*$111+$11,$FFF) : Next  
  15. For A=0 To 15 : Colour A,A*$111 : Next 
  16. Gosub PPMCREATE
  17. If Exist("ram:withpattern.ppm")
  18.   Bload "ram:withpattern.ppm",8
  19. Else 
  20.    Extension_8_0E8A 54 To 10
  21.   'Wload "dh1:sourcepattern.ppm",10
  22.   Gosub FINDPPMSTART
  23.   Gosub PATTERNFILL
  24.   CLEARBOX[16,16,15+512,15+512]
  25.    Extension_8_0472 "ram:withpattern.ppm",8
  26. End If 
  27. X1=0 : Y1=0 : X2=799 : Y2=599 : Gosub RAISEDBOX
  28. X1=8 : Y1=8 : X2=8+512+8+7 : Y2=8+512+8+7 : Gosub RECESSEDBOX
  29. X1=536 : Y1=8 : X2=615 : Y2=151 : Gosub RECESSEDBOX2
  30. CLEARBOX[X1+8,Y1+8,X2-8,Y2-8]
  31. X1=616 : Y1=8 : X2=791 : Y2=151 : Gosub RECESSEDBOX2
  32. X1=536 : Y1=156 : X2=791 : Y2=483 : Gosub RAISEDBOX2
  33. For CNT=0 To 7
  34.   X1=536+8 : Y1=156+8+CNT*40 : X2=X1+31 : Y2=Y1+31 : Gosub RECESSEDBOX
  35.   CLEARBOX[X1+8,Y1+8,X2-8,Y2-8]
  36.   X1=584 : Y1=156+8+CNT*40 : X2=X1+31 : Y2=Y1+31 : Gosub RECESSEDBOX2
  37.   X1=624 : Y1=156+8+CNT*40 : X2=783 : Y2=Y1+31 : Gosub RECESSEDBOX
  38.   CLEARBOX[X1+8,Y1+8,X2-8,Y2-8]
  39. Next 
  40. X1=536 : Y1=488 : X2=663 : Y2=Y1+47 : Gosub RAISEDBOX
  41. X1=664 : Y1=488 : X2=791 : Y2=Y1+47 : Gosub RAISEDBOX
  42. 'Wload "dh1:ko.ppm",10 
  43. 'Gosub FINDPPMSTART
  44. 'Gosub PASTELOGO 
  45.  Extension_8_0472 "ram:panel.ppm",8
  46. End 
  47. RAISEDBOX:
  48.   For A=0 To 7
  49.     VSHADE[X1+A,Y1+A,Y2-A-1,(8-A)*12]
  50.     VSHADE[X2-A,Y1+A+1,Y2-A,(A-8)*12]
  51.     HSHADE[X1+A,X2-A-1,Y1+A,(8-A)*12]
  52.     HSHADE[X1+A+1,X2-A,Y2-A,(A-8)*12]
  53.   Next 
  54. Return 
  55. RECESSEDBOX:
  56.   For A=0 To 7
  57.     VSHADE[X1+A,Y1+A,Y2-A-1,-A*12]
  58.     VSHADE[X2-A,Y1+A+1,Y2-A,A*12]
  59.     HSHADE[X1+A,X2-A-1,Y1+A,-A*12]
  60.     HSHADE[X1+A+1,X2-A,Y2-A,A*12]
  61.   Next 
  62. Return 
  63. RAISEDBOX2:
  64.   For A=0 To 7
  65.     VSHADE[X1+A,Y1+A,Y2-A,A*8]
  66.     VSHADE[X2-A,Y1+A,Y2-A,A*8]
  67.     HSHADE[X1+A,X2-A,Y1+A,A*8]
  68.     HSHADE[X1+A,X2-A,Y2-A,A*8]
  69.   Next 
  70.   For A=Y1+8 To Y2-8
  71.     HSHADE[X1+8,X2-8,A,64]
  72.   Next 
  73. Return 
  74. RECESSEDBOX2:
  75.   For A=0 To 7
  76.     VSHADE[X1+A,Y1+A,Y2-A,-A*8]
  77.     VSHADE[X2-A,Y1+A,Y2-A,-A*8]
  78.     HSHADE[X1+A,X2-A,Y1+A,-A*8]
  79.     HSHADE[X1+A,X2-A,Y2-A,-A*8]
  80.   Next 
  81.   For A=Y1+8 To Y2-8
  82.     HSHADE[X1+8,X2-8,A,-64]
  83.   Next 
  84. Return 
  85. PATTERNFILL:
  86.   For YY=0 To 599
  87.     For XX=0 To 799
  88.       BA=FFB+((YY mod OY)*OX+(XX mod OX))*3
  89.       RR=Peek(BA)
  90.       GG=Peek(BA+1)
  91.       BB=Peek(BA+2)
  92.       GR=(RR+GG+BB)/3
  93.       RR= Extension_8_1632(GR+ Extension_8_1106(XX*1.7+YY,32),0 To 255)
  94.       GG= Extension_8_1632(GR+ Extension_8_1114(YY*2.2-XX*0.6,32),0 To 255)
  95.       BB= Extension_8_1632(GR+ Extension_8_1106(XX*1.4-YY*1.9,32),0 To 255)
  96.       SETPIXEL[XX,YY,RR,GG,BB]
  97.     Next 
  98.   Next 
  99. Return 
  100. PASTELOGO:
  101.   For YY=0 To OY-1
  102.     For XX=0 To OX-1
  103.       BA=FFB+(YY*OX+XX)*3
  104.       RR=Peek(BA)
  105.       GG=Peek(BA+1)
  106.       BB=Peek(BA+2)
  107.       If RR>16 and GG>16 and BB>15
  108.         BA=BMP+((16+YY)*WX+624+XX)*3
  109.         NR=Peek(BA)
  110.         NG=Peek(BA+1)
  111.         NB=Peek(BA+2)
  112.         If XX<16
  113.           SETPIXEL[624+XX,16+YY,(RR*XX+NR*(16-XX))/16,(GG*XX+NG*(16-XX))/16,(BB*XX+NB*(16-XX))/16]
  114.         End If 
  115.         If XX>OX-16
  116.           V=(OX-1)-XX
  117.           SETPIXEL[624+XX,16+YY,(RR*V+NR*(16-V))/16,(GG*V+NG*(16-V))/16,(BB*V+NB*(16-V))/16]
  118.         End If 
  119.         If(XX>15 and XX<OX-15) or YY>6
  120.           SETPIXEL[624+XX,16+YY,RR,GG,BB]
  121.         End If 
  122.       End If 
  123.     Next 
  124.   Next 
  125. Return 
  126. PPMCREATE:
  127.   TAR$="P6"+Chr$(10)+(Str$(WX)-" ")+Str$(WY)+Chr$(10)+"255"+Chr$(10)
  128.   Reserve As Work 8,WX*WY*3+Len(TAR$)
  129.   STT=Start(8)
  130.   Poke$ STT,TAR$
  131.   BMP=STT+Len(TAR$)
  132. Return 
  133. FINDPPMSTART:
  134.   FFB=Start(10)
  135.   DAT$=Peek$(FFB,32)
  136.   D$= Extension_8_16B6(DAT$,1,Chr$(10))
  137.   OX=Val( Extension_8_16B6(D$,0," "))
  138.   OY=Val( Extension_8_16B6(D$,1," "))
  139.   NUMLF=0
  140.   Repeat 
  141.     If Peek(FFB)=10 Then Inc NUMLF
  142.     Inc FFB
  143.   Until NUMLF=3
  144. Return 
  145. IMAGECOPY:
  146.   AD=FFB
  147.   For YY=0 To OY-1
  148.     For XX=0 To OX-1
  149.       TA=BMP+(X+XX)*3+(Y+YY)*TARX*3
  150.       Poke TA,Peek(AD) : Poke TA+1,Peek(AD+1) : Poke TA+2,Peek(AD+2)
  151.       Add AD,3
  152.     Next 
  153.   Next 
  154. Return 
  155. DITHER:
  156. Data $0,$8,$2,$A
  157. Data $C,$4,$E,$6
  158. Data $3,$B,$1,$9
  159. Data $E,$7,$D,$5
  160.  
  161. Data $5,$C,$E,$3
  162. Data $8,$0,$6,$A
  163. Data $D,$2,$4,$E
  164. Data $7,$B,$9,$1
  165. Procedure CLEARBOX[XX1,YY1,XX2,YY2]
  166.   For YP=YY1 To YY2
  167.     AAA=BMP+(YP*WX+XX1)*3
  168.     For XP=XX1 To XX2
  169.       Poke AAA,0
  170.       Poke AAA+1,0
  171.       Poke AAA+2,0
  172.       Add AAA,3
  173.        Extension_8_0388 XP,YP,0
  174.     Next 
  175.   Next 
  176. End Proc
  177. Procedure VSHADE[XX,YY1,YY2,V]
  178.   For YP=YY1 To YY2
  179.     AAA=BMP+(YP*WX+XX)*3
  180.     RRX= Extension_8_1632(Peek(AAA)+V,0 To 255)
  181.     GGX= Extension_8_1632(Peek(AAA+1)+V,0 To 255)
  182.     BBX= Extension_8_1632(Peek(AAA+2)+V,0 To 255)
  183.     Poke AAA,RRX
  184.     Poke AAA+1,GGX
  185.     Poke AAA+2,BBX
  186.      Extension_8_0388 XX,YP,Min((RRX+GGX+BBX+DIT(XX and 3,YP and 3)*3)/48,15)
  187.   Next 
  188. End Proc
  189. Procedure HSHADE[XX1,XX2,YY,V]
  190.   For XP=XX1 To XX2
  191.     AAA=BMP+(YY*WX+XP)*3
  192.     RRX= Extension_8_1632(Peek(AAA)+V,0 To 255)
  193.     GGX= Extension_8_1632(Peek(AAA+1)+V,0 To 255)
  194.     BBX= Extension_8_1632(Peek(AAA+2)+V,0 To 255)
  195.     Poke AAA,RRX
  196.     Poke AAA+1,GGX
  197.     Poke AAA+2,BBX
  198.      Extension_8_0388 XP,YY,Min((RRX+GGX+BBX+DIT(XP and 3,YY and 3)*3)/48,15)
  199.   Next 
  200. End Proc
  201. Procedure SETPIXEL[X,Y,RRX,GGX,BBX]
  202.   AAA=BMP+(Y*WX+X)*3
  203.   Poke AAA,RRX
  204.   Poke AAA+1,GGX
  205.   Poke AAA+2,BBX
  206. '  Turbo Plot X,Y,Best Pen(Glue Colour(RRX/16,GGX/16,BBX/16))
  207.    Extension_8_0388 X,Y,Min((RRX+GGX+BBX+DIT(X and 3,Y and 3)*3)/48,15)
  208. End Proc